home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / acan.c next >
C/C++ Source or Header  |  1992-11-21  |  15KB  |  478 lines
  1. /* acan.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  26.         rstats[50];
  27.     integer iwidth, lwidth, nopage;
  28. } miscel_;
  29.  
  30. #define miscel_1 miscel_
  31.  
  32. struct {
  33.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  34.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  35. } cirdat_;
  36.  
  37. #define cirdat_1 cirdat_
  38.  
  39. struct {
  40.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  41.         sfactr;
  42.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  43.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  44. } status_;
  45.  
  46. #define status_1 status_
  47.  
  48. struct {
  49.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  50.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  51. } flags_;
  52.  
  53. #define flags_1 flags_
  54.  
  55. struct {
  56.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  57.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  58.          pivrel;
  59. } knstnt_;
  60.  
  61. #define knstnt_1 knstnt_
  62.  
  63. struct {
  64.     doublereal fstart, fstop, fincr, skw2, refprl, spw2;
  65.     integer jacflg, idfreq, inoise, nosprt, nosout, nosin, idist, idprt;
  66. } ac_;
  67.  
  68. #define ac_1 ac_
  69.  
  70. struct {
  71.     integer maxtim, itime, icost;
  72. } cje_;
  73.  
  74. #define cje_1 cje_
  75.  
  76. struct {
  77.     doublereal value[200000];
  78. } blank_;
  79.  
  80. #define blank_1 blank_
  81.  
  82. /* Table of constant values */
  83.  
  84. static integer c__0 = 0;
  85. static integer c__1 = 1;
  86.  
  87. /* spice version 2g.6  sccsid=acan.ma 3/15/83 */
  88. /*<       subroutine acan >*/
  89. /* Subroutine */ int acan_()
  90. {
  91.     /* Format strings */
  92.     static char fmt_121[] = "(\0020warning:  underflow \002,i4,\002 time(s) \
  93. in ac analysis at freq = \002,1pd9.3,\002 hz\002)";
  94.     static char fmt_901[] = "(\0020*error*:  cpu time limit exceeded ... ana\
  95. lysis stopped\002/)";
  96.  
  97.     /* System generated locals */
  98.     integer i_1, i_2, i_3;
  99.     doublereal d_1, d_2;
  100.     complex q_1;
  101.  
  102.     /* Builtin functions */
  103.     integer s_wsfe(), do_fio(), e_wsfe();
  104.  
  105.     /* Local variables */
  106.     static integer loco;
  107.     static doublereal freq;
  108.     static integer iptr, node1, node2;
  109.     extern /* Subroutine */ int getm8_();
  110.     static integer nandd, ibuff;
  111.     extern /* Subroutine */ int acsol_(), getm16_(), dinit_(), noise_();
  112.     static doublereal t1;
  113.     extern /* Subroutine */ int copy16_(), disto_();
  114.     static doublereal t2;
  115.     extern /* Subroutine */ int acload_(), acdcmp_(), getcje_(), pheadr_();
  116. #define nodplc ((integer *)&blank_1)
  117. #define cvalue ((complex *)&blank_1)
  118.     extern /* Subroutine */ int second_();
  119.     static integer numcur, numpos, loc, loccur;
  120.     extern /* Subroutine */ int crunch_();
  121.     static integer numout, lcvntp;
  122.     extern /* Subroutine */ int extmem_(), dblsgl_(), fwrite_(), clsraw_(), 
  123.         clrmem_();
  124.  
  125.     /* Fortran I/O blocks */
  126.     static cilist io__13 = { 0, 0, 0, fmt_121, 0 };
  127.     static cilist io__18 = { 0, 0, 0, fmt_901, 0 };
  128.  
  129.  
  130. /*<       implicit double precision (a-h,o-z) >*/
  131.  
  132. /*     this routine drives the small-signal analyses. */
  133.  
  134. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  135. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  136. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  137. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  138. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  139. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  140. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  141. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  142. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  143. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  144. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  145. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  146. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  147. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  148. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  149. /* spice version 2g.6  sccsid=status 3/15/83 */
  150. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  151. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  152. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  153. /* spice version 2g.6  sccsid=flags 3/15/83 */
  154. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  155. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  156. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  157. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  158. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  159. /*<      2   pivtol,pivrel >*/
  160. /* spice version 2g.6  sccsid=ac 3/15/83 */
  161. /*<       common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq, >*/
  162. /*<      1   inoise,nosprt,nosout,nosin,idist,idprt >*/
  163. /* spice version 2g.6  sccsid=cje 3/15/83 */
  164. /*<       common /cje/ maxtim,itime,icost >*/
  165. /* spice version 2g.6  sccsid=blank 3/15/83 */
  166. /*<       common /blank/ value(200000) >*/
  167. /*<       integer nodplc(64) >*/
  168. /*<       complex cvalue(32) >*/
  169. /*<       complex cendor >*/
  170. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  171. /*<       call second(t1) >*/
  172.     second_(&t1);
  173. /* .. post-processor initialization */
  174. /*<       if(ipostp.eq.0) go to 1 >*/
  175.     if (status_1.ipostp == 0) {
  176.     goto L1;
  177.     }
  178. /*<       numcur=jelcnt(9) >*/
  179.     numcur = cirdat_1.jelcnt[8];
  180. /*<       numpos=nunods+numcur >*/
  181.     numpos = cirdat_1.nunods + numcur;
  182. /*<       call getm16(ibuff,numpos) >*/
  183.     getm16_(&ibuff, &numpos);
  184. /*<       numpos=numpos*4 >*/
  185.     numpos <<= 2;
  186. /*<       if(numcur.eq.0) go to 1 >*/
  187.     if (numcur == 0) {
  188.     goto L1;
  189.     }
  190. /*<       loc=locate(9) >*/
  191.     loc = cirdat_1.locate[8];
  192. /*<       loccur=nodplc(loc+6)-1 >*/
  193.     loccur = nodplc[loc + 5] - 1;
  194.  
  195. /*  allocate storage */
  196.  
  197. /*<     1 call getm8(ndiag,2*nstop) >*/
  198. L1:
  199.     i_1 = cirdat_1.nstop << 1;
  200.     getm8_(&tabinf_1.ndiag, &i_1);
  201. /*<       call getm8(lvn,nstop+nttbr) >*/
  202.     i_1 = cirdat_1.nstop + tabinf_1.nttbr;
  203.     getm8_(&tabinf_1.lvn, &i_1);
  204. /*<       call getm8(imvn,nstop+nttbr) >*/
  205.     i_1 = cirdat_1.nstop + tabinf_1.nttbr;
  206.     getm8_(&tabinf_1.imvn, &i_1);
  207. /*<       call getm16(lcvn,nstop) >*/
  208.     getm16_(&tabinf_1.lcvn, &cirdat_1.nstop);
  209. /*<       if (idist.ne.0) call dinit >*/
  210.     if (ac_1.idist != 0) {
  211.     dinit_();
  212.     }
  213. /*<       nandd=0 >*/
  214.     nandd = 0;
  215. /*<       if (inoise.eq.0) go to 10 >*/
  216.     if (ac_1.inoise == 0) {
  217.     goto L10;
  218.     }
  219. /*<       if (idist.eq.0) go to 10 >*/
  220.     if (ac_1.idist == 0) {
  221.     goto L10;
  222.     }
  223. /*<       nandd=1 >*/
  224.     nandd = 1;
  225. /*<       call getm16(lvntmp,nstop) >*/
  226.     getm16_(&tabinf_1.lvntmp, &cirdat_1.nstop);
  227. /*<    10 call getm16(loutpt,0) >*/
  228. L10:
  229.     getm16_(&tabinf_1.loutpt, &c__0);
  230. /*<       call crunch >*/
  231.     crunch_();
  232. /*<       numout=jelcnt(43)+jelcnt(44)+jelcnt(45)+1 >*/
  233.     numout = cirdat_1.jelcnt[42] + cirdat_1.jelcnt[43] + cirdat_1.jelcnt[44] 
  234.         + 1;
  235. /*<       lynl=lvn >*/
  236.     tabinf_1.lynl = tabinf_1.lvn;
  237. /*<       imynl=imvn >*/
  238.     tabinf_1.imynl = tabinf_1.imvn;
  239. /*<       lcvntp=lvntmp >*/
  240.     lcvntp = tabinf_1.lvntmp;
  241. /*<       icalc=0 >*/
  242.     status_1.icalc = 0;
  243. /*<       if (ipostp.ne.0) call pheadr(atitle) >*/
  244.     if (status_1.ipostp != 0) {
  245.     pheadr_(miscel_1.atitle);
  246.     }
  247. /*<       freq=fstart >*/
  248.     freq = ac_1.fstart;
  249.  
  250. /*  load y matrix and c vector, solve for v vector */
  251.  
  252. /*<   100 call getcje >*/
  253. L100:
  254.     getcje_();
  255. /*<       if ((maxtim-itime).le.limtim) go to 900 >*/
  256.     if (cje_1.maxtim - cje_1.itime <= flags_1.limtim) {
  257.     goto L900;
  258.     }
  259. /*<       omega=twopi*freq >*/
  260.     status_1.omega = knstnt_1.twopi * freq;
  261. /*<       call acload >*/
  262.     acload_();
  263. /*<   110 call acdcmp >*/
  264. /* L110: */
  265.     acdcmp_();
  266. /*<       call acsol >*/
  267.     acsol_();
  268. /*<       if (igoof.eq.0) go to 200 >*/
  269.     if (flags_1.igoof == 0) {
  270.     goto L200;
  271.     }
  272. /*<       write (iofile,121) igoof,freq >*/
  273.     io__13.ciunit = status_1.iofile;
  274.     s_wsfe(&io__13);
  275.     do_fio(&c__1, (char *)&flags_1.igoof, (ftnlen)sizeof(integer));
  276.     do_fio(&c__1, (char *)&freq, (ftnlen)sizeof(doublereal));
  277.     e_wsfe();
  278. /*<   121 format('0warning:  underflow ',i4,' time(s) in ac analysis at freq >*/
  279. /*<      1 = ',1pd9.3,' hz') >*/
  280. /*<       igoof=0 >*/
  281.     flags_1.igoof = 0;
  282.  
  283. /*  store outputs */
  284.  
  285. /*<   200 call extmem(loutpt,numout) >*/
  286. L200:
  287.     extmem_(&tabinf_1.loutpt, &numout);
  288. /*<       loco=loutpt+icalc*numout >*/
  289.     loco = tabinf_1.loutpt + status_1.icalc * numout;
  290. /*<       icalc=icalc+1 >*/
  291.     ++status_1.icalc;
  292. /*<       cvalue(loco+1)=cmplx(sngl(freq),sngl(omega)) >*/
  293.     i_1 = loco;
  294.     d_1 = freq;
  295.     d_2 = status_1.omega;
  296.     q_1.r = d_1, q_1.i = d_2;
  297.     cvalue[i_1].r = q_1.r, cvalue[i_1].i = q_1.i;
  298. /*<       loc=locate(43) >*/
  299.     loc = cirdat_1.locate[42];
  300. /*<   310 if (loc.eq.0) go to 350 >*/
  301. L310:
  302.     if (loc == 0) {
  303.     goto L350;
  304.     }
  305. /*<       if (nodplc(loc+5).ne.0) go to 320 >*/
  306.     if (nodplc[loc + 4] != 0) {
  307.     goto L320;
  308.     }
  309. /*<       node1=nodplc(loc+2) >*/
  310.     node1 = nodplc[loc + 1];
  311. /*<       node2=nodplc(loc+3) >*/
  312.     node2 = nodplc[loc + 2];
  313. /*<       iseq=nodplc(loc+4) >*/
  314.     tabinf_1.iseq = nodplc[loc + 3];
  315. /*<       cvalue(loco+iseq)=cvalue(lcvn+node1)-cvalue(lcvn+node2) >*/
  316.     i_1 = loco + tabinf_1.iseq - 1;
  317.     i_2 = tabinf_1.lcvn + node1 - 1;
  318.     i_3 = tabinf_1.lcvn + node2 - 1;
  319.     q_1.r = cvalue[i_2].r - cvalue[i_3].r, q_1.i = cvalue[i_2].i - cvalue[i_3]
  320.         .i;
  321.     cvalue[i_1].r = q_1.r, cvalue[i_1].i = q_1.i;
  322. /*<       loc=nodplc(loc) >*/
  323.     loc = nodplc[loc - 1];
  324. /*<       go to 310 >*/
  325.     goto L310;
  326. /*<   320 iptr=nodplc(loc+2) >*/
  327. L320:
  328.     iptr = nodplc[loc + 1];
  329. /*<       iptr=nodplc(iptr+6) >*/
  330.     iptr = nodplc[iptr + 5];
  331. /*<       iseq=nodplc(loc+4) >*/
  332.     tabinf_1.iseq = nodplc[loc + 3];
  333. /*<       cvalue(loco+iseq)=cvalue(lcvn+iptr) >*/
  334.     i_1 = loco + tabinf_1.iseq - 1;
  335.     i_2 = tabinf_1.lcvn + iptr - 1;
  336.     cvalue[i_1].r = cvalue[i_2].r, cvalue[i_1].i = cvalue[i_2].i;
  337. /*<       loc=nodplc(loc) >*/
  338.     loc = nodplc[loc - 1];
  339. /*<       go to 310 >*/
  340.     goto L310;
  341. /*<   350 if(ipostp.eq.0) go to 400 >*/
  342. L350:
  343.     if (status_1.ipostp == 0) {
  344.     goto L400;
  345.     }
  346. /*<       cvalue(ibuff+1)=cmplx(sngl(freq),0.0e0) >*/
  347.     i_1 = ibuff;
  348.     d_1 = freq;
  349.     q_1.r = d_1, q_1.i = (float)0.;
  350.     cvalue[i_1].r = q_1.r, cvalue[i_1].i = q_1.i;
  351. /*<       call copy16(cvalue(lcvn+2),cvalue(ibuff+2),nunods-1) >*/
  352.     i_1 = cirdat_1.nunods - 1;
  353.     copy16_(&cvalue[tabinf_1.lcvn + 1], &cvalue[ibuff + 1], &i_1);
  354. /*<       if(numcur.ne.0) call copy16(cvalue(lcvn+loccur+1), >*/
  355. /*<      1  cvalue(ibuff+nunods+1),numcur) >*/
  356.     if (numcur != 0) {
  357.     copy16_(&cvalue[tabinf_1.lcvn + loccur], &cvalue[ibuff + 
  358.         cirdat_1.nunods], &numcur);
  359.     }
  360. /*<       call dblsgl(cvalue(ibuff+1),numpos) >*/
  361.     dblsgl_(&cvalue[ibuff], &numpos);
  362. /*<       call fwrite(cvalue(ibuff+1),numpos) >*/
  363.     fwrite_(&cvalue[ibuff], &numpos);
  364.  
  365. /*  noise and distortion analyses */
  366.  
  367. /*<   400 if (nandd.eq.0) go to 410 >*/
  368. L400:
  369.     if (nandd == 0) {
  370.     goto L410;
  371.     }
  372. /*<       call copy16(cvalue(lcvn+1),cvalue(lcvntp+1),nstop) >*/
  373.     copy16_(&cvalue[tabinf_1.lcvn], &cvalue[lcvntp], &cirdat_1.nstop);
  374. /*<   410 if (inoise.ne.0) call noise(loco) >*/
  375. L410:
  376.     if (ac_1.inoise != 0) {
  377.     noise_(&loco);
  378.     }
  379. /*<       if (nandd.eq.0) go to 420 >*/
  380.     if (nandd == 0) {
  381.     goto L420;
  382.     }
  383. /*<       call copy16(cvalue(lcvntp+1),cvalue(lcvn+1),nstop) >*/
  384.     copy16_(&cvalue[lcvntp], &cvalue[tabinf_1.lcvn], &cirdat_1.nstop);
  385. /*<   420 if (idist.ne.0) call disto(loco) >*/
  386. L420:
  387.     if (ac_1.idist != 0) {
  388.     disto_(&loco);
  389.     }
  390.  
  391. /*  increment frequency */
  392.  
  393. /*<       if (icalc.ge.jacflg) go to 1000 >*/
  394.     if (status_1.icalc >= ac_1.jacflg) {
  395.     goto L1000;
  396.     }
  397. /*<       if (idfreq.ge.3) go to 510 >*/
  398.     if (ac_1.idfreq >= 3) {
  399.     goto L510;
  400.     }
  401. /*<       freq=freq*fincr >*/
  402.     freq *= ac_1.fincr;
  403. /*<       go to 100 >*/
  404.     goto L100;
  405. /*<   510 freq=freq+fincr >*/
  406. L510:
  407.     freq += ac_1.fincr;
  408. /*<       go to 100 >*/
  409.     goto L100;
  410.  
  411. /*  finished */
  412.  
  413. /*<   900 write (iofile,901) >*/
  414. L900:
  415.     io__18.ciunit = status_1.iofile;
  416.     s_wsfe(&io__18);
  417.     e_wsfe();
  418. /*<   901 format('0*error*:  cpu time limit exceeded ... analysis stopped'/) >*/
  419. /*<       nogo=1 >*/
  420.     flags_1.nogo = 1;
  421. /*<  1000 if(ipostp.eq.0) go to 1010 >*/
  422. L1000:
  423.     if (status_1.ipostp == 0) {
  424.     goto L1010;
  425.     }
  426. /*<       if (ipostp.ne.0) call clsraw >*/
  427.     if (status_1.ipostp != 0) {
  428.     clsraw_();
  429.     }
  430. /*<       if(ipostp.ne.0) call clrmem(ibuff) >*/
  431.     if (status_1.ipostp != 0) {
  432.     clrmem_(&ibuff);
  433.     }
  434. /*<  1010 call clrmem(lvnim1) >*/
  435. L1010:
  436.     clrmem_(&tabinf_1.lvnim1);
  437. /*<       call clrmem(lx0) >*/
  438.     clrmem_(&tabinf_1.lx0);
  439. /*<       call clrmem(lvn) >*/
  440.     clrmem_(&tabinf_1.lvn);
  441. /*<       call clrmem(imvn) >*/
  442.     clrmem_(&tabinf_1.imvn);
  443. /*<       call clrmem(lcvn) >*/
  444.     clrmem_(&tabinf_1.lcvn);
  445. /*<       call clrmem(ndiag) >*/
  446.     clrmem_(&tabinf_1.ndiag);
  447. /*<       if (idist.eq.0) go to 1020 >*/
  448.     if (ac_1.idist == 0) {
  449.     goto L1020;
  450.     }
  451. /*<       call clrmem(ld0) >*/
  452.     clrmem_(&tabinf_1.ld0);
  453. /*<       call clrmem(ld1) >*/
  454.     clrmem_(&tabinf_1.ld1);
  455. /*<  1020 if (nandd.eq.0) go to 1040 >*/
  456. L1020:
  457.     if (nandd == 0) {
  458.     goto L1040;
  459.     }
  460. /*<       call clrmem(lvntmp) >*/
  461.     clrmem_(&tabinf_1.lvntmp);
  462. /*<  1040 call second(t2) >*/
  463. L1040:
  464.     second_(&t2);
  465. /*<       rstats(7)=rstats(7)+t2-t1 >*/
  466.     miscel_1.rstats[6] = miscel_1.rstats[6] + t2 - t1;
  467. /*<       rstats(8)=rstats(8)+icalc >*/
  468.     miscel_1.rstats[7] += status_1.icalc;
  469. /*<       return >*/
  470.     return 0;
  471. /*<       end >*/
  472. } /* acan_ */
  473.  
  474. #undef cvalue
  475. #undef nodplc
  476.  
  477.  
  478.